-- card: 5488 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: FileToClip
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,FileToClip,it
end Install


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=79 top=300 right=322 bottom=179
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: FileToClip
----- HyperTalk script -----
on mouseUp
  FileToClip
  put the result
end mouseUp



-- part 2 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part 3 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part contents for background part 16
----- text -----
FILETOCLIP XCMD version 1.5
Kevin Calhoun

The FileToClip XCMD copies the contents of a text file to the clipboard.  You choose the text file from a standard file dialog box.  Once the text is on the clipboard, you can then paste it into a field, into another application running concurrently under MultiFinder, or into a desk accessory (such as McSink).

If an error occurs, FileToClip will return an error message as the result.  Word 1 of this message will be "Error".  If the text was copied successfully, FileToClip returns the full pathname of the file as the result.

If you want the text to go directly to a HyperCard field without having to paste it manually, use the FileToField XCMD.

FileToClip takes no parameters.


-- part contents for card part 3
----- text -----
UNIT ReadToClipUnit;

{ FileToClip XCMD © 1988-1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal FileToClip.p
Link -m ENTRYPOINT ∂
     -o "YourFile" ∂
     -rt XCMD=2234 ∂
     -sn Main=FileToClip ∂
     FileToClip.p.o ∂
    "{Libraries}"interface.o ∂
    "{PLibraries}"Paslib.o ∂
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE

  USES
    Types,
    Memory,
    Files,
    Resources,
    Scrap,
    Packages,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCmdPtr);

IMPLEMENTATION

  PROCEDURE ReadFileToClip (paramPtr : XCmdPtr); FORWARD;
  
  PROCEDURE EntryPoint (paramPtr : XCmdPtr);
  BEGIN
    ReadFileToClip(paramPtr);
  END;

  FUNCTION GetScreenBitsBounds: Rect;
  { get screenbits.bounds from the QuickDraw globals }
  TYPE
    LongwordPtr = ^LONGINT;
    BitMapPtr = ^BitMap;
  CONST
    screenBitsOffset = -122;
    CurrentA5 = $904;
  VAR
    screenBitsPtr : BitMapPtr;
    myLongwordPtr : LongwordPtr;
  BEGIN
    myLongwordPtr := LongwordPtr(CurrentA5);
      { myLongwordPtr now points to the pointer to the first QD global }
    myLongwordPtr := LongwordPtr(myLongwordPtr^);
      { myLongwordPtr now points to the first QD global }
    screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
      { screenBitsPtr now points to the screenBits BitMap }
    GetScreenBitsBounds := screenBitsPtr^.bounds;
  END;

  FUNCTION BuildThePathname (fName : Str255;
                  vRefNum : INTEGER) : Str255;
{ Given the "short name" and vRefNum of a file, returns the full pathname. }
{ This function is adapted from Steve Maller's FileName XFCN published in }
{ HyperTalk Programming by Dan Shafer, Howard W. Sams & Company, 1988, }
{ pp. 399-403. }
    VAR
      name, fullPathName : Str255;
      err : INTEGER;
      myWDPB : WDPBPtr;
      myCPB : CInfoPBPtr;
      myPB : HParmBlkPtr;

  BEGIN
    fullPathName := '';     { start with an empty pathname }
{ Allocate some memory in the heap for the parameter block. }
    myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
    IF ord4(myCPB) > 0 THEN    { continue if mem allocation was OK }

      BEGIN
        myWDPB := WDPBPtr(myCPB);
        myPB := HParmBlkPtr(myCPB);
{ same pointer, different variations of the record -- see IM IV, p. 117 }
        name := '';     { start with an empty name for the volume }

        WITH myPB^ DO
          BEGIN
            ioNamePtr := @name;   { we want the volume name }
            ioCompletion := pointer(0);
            ioVRefNum := vRefNum;  { returned by SFGetFile }
            ioVolIndex := 0;  { use the vRefNum and name only to designate volume }
          END;
        err := PBHGetVInfo(myPB, FALSE);  { fill in the volume info }
        IF err = noErr THEN

          BEGIN
{ Now we need the Working Directory (WD) information because we're }
{ going to step backwards from the file through all of the folders until }
{ we reach the root directory. }
            WITH myWDPB^ DO
              BEGIN
                ioVRefNum := vRefNum;  { this got set to 0 above }
                ioWDProcID := 0;   { use the vRefNum }
                ioWDIndex := 0;     { we want all directories }
              END;
            err := PBGetWDInfo(myWDPB, FALSE);
            IF err = noErr THEN
              BEGIN
                WITH myCPB^ DO
                  BEGIN
                    ioFDirIndex := -1;   { use the ioDirID field only }
                    ioDrDirID := myWDPB^.ioWDDirID;   { info returned above }
                  END;
                err := PBGetCatInfo(myCPB, FALSE);
                IF err = noErr THEN
                  BEGIN

{ Here starts the real work -- start to climb the tree by continually }
{ looking in the ioDrParID field for the next directory above until we fail... }
                    myCPB^.ioDrDirID := myCPB^.ioDrParID;  { the first folder }
                    fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fName);
                    REPEAT
                      myCPB^.ioDrDirID := myCPB^.ioDrParId;
                      err := PBGetCatInfo(myCPB, FALSE);    { the next level }
{ Be careful of an error returned here -- it means the user chose a file on the }
{ desktop level of this volume.  If this is the case, just stop here and return }
{ "VolumeName:FileName"; otherwise loop until failure. }
                      IF err = noErr THEN
                        fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fullPathName);
                    UNTIL err <> noErr;
                  END;  { if PBGetCatInfo worked OK }
              END;  { if PBGetWDInfo worked OK }
          END;  { if PBHGetVInfo worked OK }
        DisposPtr(pointer(myCPB));
      END;  { if we had enough room for a new pointer }
    BuildThePathname := fullPathName;
  END;

  PROCEDURE ReadFileToClip (paramPtr : XCmdPtr);
    VAR

      { for SFGetFile }
      where : point;
      typeList : SFTypeList;
      reply : SFReply;
      dlgt: DialogTHndl;
      r: rect;
      screen: rect;
      h, v: INTEGER;

      theRefNum : INTEGER;  { file ref num for file manager calls }
      err : OSErr;  { save error codes to report trouble }
      logEOF : longint;  { length of file }
      theBufHndl : Handle;  { to allocate memory for reading in contents of file }
      numStr : Str255;

    PROCEDURE passReturnValue (theMsg : Str255); { set theResult }
    BEGIN
      paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
    END;

  BEGIN
    IF paramPtr^.paramCount <> 0 THEN
{ if we got parameters then return version number }
      passReturnValue('FileToClip XCMD 1.5, 15 March 1989, ©1988-1989 Dartmouth College')
    ELSE
      BEGIN
{ select text file to read using SFGetFile }

        dlgt := DialogTHndl(GetResource('DLOG',getDlgID));
        if dlgt <> nil then
          begin
          r := dlgt^^.boundsRect;
          screen := GetScreenBitsBounds;
          h := ((screen.right - screen.left) - (r.right - r.left)) div 2;
          v := ((screen.bottom - screen.top) - (r.bottom - r.top)) div 2;
          SetPt(where, h, v);
          end
        else SetPt(where, 82, 75);             { tell SFGetFile where to put the dialog box }
        typeList[0] := 'TEXT';                { tell SFGetFile to display only text files }
        SFGetFile(where, '', NIL, 1, typeList, NIL, reply);          { call SFGetFile }

        IF reply.good = TRUE THEN          { continue only if user actually selected a file }
          BEGIN
            WITH reply DO
              err := FSOpen(fName, vRefNum, theRefNum);  { open the file }

            IF err = noErr THEN              { continue only if file could be opened }
              BEGIN
                err := GetEOF(theRefNum, logEOF);

                IF err = noErr THEN
                  BEGIN   { set up the buffer in memory for reading in logEOF characters }
                    theBufHndl := NewHandle(logEOF);
                    err := MemError;  { save the result in case we want to report an error }
                    IF (theBufHndl <> NIL) AND (err = noErr) THEN
                           { continue only if enough memory is available }
                      BEGIN
                        MoveHHi(theBufHndl);
                        HLock(theBufHndl);  { lock down our buffer }
                { read logEOF characters into the location pointed to by theBufHandle^ }
                        err := FSRead(theRefNum, logEOF, theBufHndl^);

                        IF err = noErr THEN      { continue only if the read worked }
                          BEGIN
                            err := ZeroScrap;  { reinitialize the scrap }

                            IF err = noErr THEN  { continue only if we reinitialized the scrap }
                              BEGIN
                                err := PutScrap(logEOF, 'TEXT', theBufHndl^);
                                                  { put our text onto the scrap }
                                IF err = noErr THEN
                                  err := TEFromScrap;  { make our text available to TextEdit }

                              END;   { if err = noErr when clearing the scrap }
                          END;  { if err = noErr when reading the file into memory }
                        DisposHandle(theBufHndl);   { deallocate the memory we used }
                      END;  { if theBufHndl <> nil and MemError = noErr }
                  END;  { if there was no problem getting the EOF }
                err := FSClose(theRefNum);            { close the file }
              END;   { if err = noErr in opening the file }
            IF err = noErr THEN
              PassReturnValue(BuildThePathName(reply.fName, reply.vRefNum))
            ELSE
              BEGIN
              NumToStr(paramPtr, err, numStr);
              PassReturnValue(CONCAT('Error ', numStr));
              END;
          END;  { if the SF reply.good = TRUE }
      END;
  END;

END.